home *** CD-ROM | disk | FTP | other *** search
/ Shareware Grab Bag / Shareware Grab Bag.iso / 090 / pcpm.arc / CPAPRES.BAS (.txt) < prev    next >
Encoding:
GW-BASIC  |  1985-06-04  |  2.8 KB  |  108 lines
  1. 20  CLOSE
  2. 50  DIM V(100),T$(11),X$(12)
  3. 60  DIM S(500),F(500),D$(500),D(500)
  4. 70  DIM P(3000)
  5. 100  GOSUB 5000         'READ IN INPUT FILE
  6. 110  INPUT "Enter Predecessor or Successor (P/S) ",Q$
  7. 120  IF LEFT$(Q$,1)="P" THEN F1=1 ELSE F1=0       'F1=1 THEN PREDESSOR
  8. 130  IF F1=1 THEN OPEN F$+".PRE" FOR OUTPUT AS #1 ELSE OPEN F$+".SUC" FOR OUTPUT AS #1
  9. 140  IF F1=1 THEN T$="PRECEEDOR " ELSE T$="SUCCEEDOR "
  10. 150  FOR I=1 TO N:P(I)=I:NEXT
  11. 180  P6=0
  12. 190  FOR I=1 TO 12
  13. 200  READ X$(I)
  14. 210  NEXT I
  15. 220  DATA "JAN","FEB","MAR","APR","MAY","JUN","JUL","AUG","SEP","OCT","NOV","DEC"
  16. 230  B4=VAL(MID$(DATE$,1,2))
  17. 240  B5=VAL(MID$(DATE$,4,2))
  18. 250  B6=VAL(MID$(DATE$,9,2))
  19. 270  GOSUB 660
  20. 310  PRINT "**** SORTING";N;"ACTIVITIES ****";
  21. 320  GOSUB 7000
  22. 330  PRINT " FINSHED SORTING ****":PRINT "**** THE FOLLOWING INDICATES HOW MANY ";T$;"S EXIST FOR EACH ACTIVITY ****"
  23. 360  K1=1
  24. 370  IF F1=1 THEN N1=S(P(K1)) ELSE N1=F(P(K1))
  25. 380  J2=0
  26. 390  FOR I=1 TO N
  27. 400  IF F1=1 THEN J5=F(P(I)) ELSE J5=S(P(I))
  28. 410  IF J5<>N1 THEN 440
  29. 420  J2=J2+1
  30. 430  A5(J2)=P(I)
  31. 440  NEXT I
  32. 450  PRINT #1,TAB(3);S(P(K1));TAB(9);F(P(K1));
  33. 460  PRINT J2;
  34. 470  IF J2=0 THEN 540
  35. 480  FOR I=1 TO J2
  36. 490  Q=(I-1)*12+1
  37. 500  IF I<10 THEN 520 ELSE Q=(I-10)*12+1
  38. 510  IF I=10 THEN PRINT #1,G9$
  39. 520  PRINT #1,TAB(15+Q);S(A5(I));TAB(21+Q);F(A5(I));
  40. 530  NEXT I
  41. 540  PRINT #1,G9$
  42. 550  K1=K1+1
  43. 560  IF K1>N THEN 590
  44. 570  IF K1/50=INT(K1/50) THEN GOSUB 660
  45. 580  GOTO 370
  46. 590  PRINT
  47. 600  PRINT "**** ";T$;" DISPLAY CREATED AND EXISTS IN ";
  48. 610  IF F1=1 THEN PRINT F$+".PRE";" ****" ELSE PRINT F$+".SUC";" ****"
  49. 620  PRINT
  50. 630  INPUT "Press ENTER to continue ",Q$
  51. 640  CLOSE #1
  52. 650  CHAIN "CPAMENU"
  53. 660  REM WRITE PAGE HEADING SUBROUTINE
  54. 670  P6=P6+1
  55. 680  T4=INT((120-LEN(T$+"DISPLAY"))/2)
  56. 690  T5=INT((120-LEN(P$))/2)
  57. 700  PRINT #1,TAB(T5);P$;TAB(115);"PAGE";P6
  58. 710  PRINT #1,G9$
  59. 720  PRINT #1,TAB(T4);T$;"DISPLAY";TAB(99);"RUN DATE: ";X$(B4);B5;", 19";RIGHT$(STR$(B6),2)
  60. 730  PRINT #1,G9$
  61. 740  R$="  ACTIVITY    "
  62. 750  R2$=" I     J   "
  63. 760  PRINT #1,R$;T$;" ";T$;" ";T$;" ";T$;" ";T$;" ";T$;" ";T$;" ";T$;" ";T$
  64. 770  R4$="I     J    "
  65. 780  PRINT #1,TAB(4);R4$;R2$;R2$;R2$;R2$;R2$;R2$;R2$;R2$;R2$
  66. 790  PRINT #1,G9$
  67. 800  RETURN
  68. 5000  REM **** READING IN ALREADY CREATED INPUT FILE ******************
  69. 5010  INPUT "Enter the name of the input file [.CPM] ";G$
  70. 5015  IF G$="Q" OR G$="QUIT" THEN 3500
  71. 5020  P=INSTR(1,G$,"."):IF P<>0 THEN F$=LEFT$(G$,INSTR(1,G$,".")-1) ELSE F$=G$
  72. 5030  IF LEN(F$)>8 THEN PRINT "**** NOT A VALID PCPM FILE ****":BEEP:GOTO 5010
  73. 5035  ON ERROR GOTO 5300
  74. 5037  G$=F$+".CPM"
  75. 5040  OPEN G$ FOR INPUT AS #3
  76. 5050  INPUT #3,P$,T6$,DA$
  77. 5060  I=0
  78. 5070  I=I+1
  79. 5080  IF EOF(3) THEN 5130
  80. 5090  INPUT #3,D$,S(I),F(I),O2,D,A6,PC,B,CT
  81. 5100  IF S(I)>N8 THEN N8=S(I)   'HIGHEST START NODE NUMBER=N8
  82. 5110  IF I/10=INT(I/10) THEN PRINT I;
  83. 5120  GOTO 5070
  84. 5130  N=I-1
  85. 5140  M6=VAL(LEFT$(DA$,2)):D6=VAL(MID$(DA$,3,2)):Y6=VAL(RIGHT$(DA$,2))
  86. 5150  CLOSE #3
  87. 5160  PRINT " **** INPUT FILE READ ****"
  88. 5170  RETURN
  89. 5300  PRINT "**** FILE DOES NOT EXIST - TRY AGAIN ****":BEEP:GOTO 5000
  90. 7000  REM **** SHELL METZNER SORT ****************************************
  91. 7010  J=N
  92. 7020  FOR I=1 TO N:P(I)=J:J=J-1:NEXT I
  93. 7030  M=N
  94. 7040  M=INT(M/2)
  95. 7050  IF M=0 THEN RETURN
  96. 7060  J=1
  97. 7070  K=N-M
  98. 7080  I=J
  99. 7090  L=I+M
  100. 7100  IF S(P(I))<S(P(L)) THEN 7150
  101. 7110  SWAP P(I),P(L)
  102. 7120  I=I-M
  103. 7130  IF I<1 THEN 7150
  104. 7140  GOTO 7090
  105. 7150  J=J+1
  106. 7160  IF J>K THEN 7040
  107. 7170  GOTO 7080
  108.